Internet Info 1993

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1993 / Internet Info CD-ROM (Walnut Creek) (1993).iso / networking / terms / kermit / d / k10sys.mac < prev next >

Wrap

Text File | 1990-12-01 | 23.9 KB | 754 lines

TITLE KERSYS - System interface routines SUBTTL Robert C. McQueen, Nick Bush ; Universals SEARCH GLXMAC ; Galaxy definitions SEARCH KERUNV ; Kermit definitions ; Directives PROLOG (KERSYS) .DIREC FLBLST ; List file line of binary only ; Version number SYSVER==3 ; Major version number SYSMIN==0 ; Minor version number SYSEDT==125 ; Edit level SYSWHO==0 ; Customer edit TWOSEG 400K ; Make this a two segment program RELOC 0 ; Low segment RELOC ; Back to the high segment SUBTTL Table of Contents ;+ ;.pag.lit ; Table of Contents of KERSYS ; ; ; Section Page ; 1. Table of Contents. . . . . . . . . . . . . . . . . . . . . . . . 2 ; 2. Revision History . . . . . . . . . . . . . . . . . . . . . . . . 3 ; 3. Operating system interface ; 3.1. SY%TIME . . . . . . . . . . . . . . . . . . . . . . . . . . 4 ; 3.2. SY%LOGOUT . . . . . . . . . . . . . . . . . . . . . . . . . 5 ; 3.3. SY%DISMISS. . . . . . . . . . . . . . . . . . . . . . . . . 6 ; 4. End of KERSYS. . . . . . . . . . . . . . . . . . . . . . . . . . 7 ; ;.end lit.pag ;- SUBTTL Revision History COMMENT | 116 By: Nick Bush On: 14-March-1984 Add parsing for all REMOTE commands. Add support for some generic and local commands. Fix wild card processing to handle pathological names correctly. Modules: KERMIT,KERSYS,KERWLD 117 By: Nick Bush On: 14-March-1984 Add code to support changing default path. Modules: KERSYS 123 By: Nick Bush On: 2-April-1984 Change SPACE generic command to use PPN of default path instead of users PPN if no argument is supplied. Make DIRECTORY and DELETE generic commands print out a header at the top of the list, and print file size in both words and allocated blocks. Add SPACE as synonym for DISK-USAGE command and ERASE as synonym for DELETE. Modules: KERMIT,KERSYS Start of Version 3(124) 125 By: Nick Bush On: 26-June-1984 Add patches from CSM: - Wrong AC when setting PIM break set. - Checks for not-logged-in Kermits - Parity for CONNECT (implemented differently) Modules: KERMIT,KERSYS | SUBTTL Initialization routine ; This routine will initialize the operating system interface. SY%INIT:: MOVEI S1,LOWSIZ ; Get size of low segment MOVEI S2,LOWBEG ; And start address $CALL .ZCHNK ; Clear it out ; Now read default path MOVX S1,.PTFRD ; Get the function MOVEM S1,DEFPTH+.PTFCN ; Store it MOVE S1,[XWD .PTMAX,DEFPTH] ; Point at the block PATH. S1, ; And get the path JFCL ; Ignore errors $RETT ; And return SUBTTL Operating system interface -- SY%TIME ;+ ;.HL1 SY%TIME () ;This routine will return the current system uptime in milliseconds to ;KERMSG. This is used to calculate the effective baud rate for the sending ;and receiving of messages. ;- BLSRTN(SY%TIME) TOPS10< $SAVE <T1,T2,T3,T4> ; Save a few registers MOVX T1,%CNSUP ; Get the system uptime GETTAB T1, ; . . . SETZ T1, ; Clear assume zero MULX T1,^D1000 ; Convert to milliseconds DIV T1,JIFSEC## ; . . . MOVE S1,T1 ; Move to the return location >; End of TOPS10 conditional POPJ P, ; Return to the caller SUBTTL Operating system interface -- SY%LOGOUT ;+ ;.HL1 SY%LOGOUT () ;This routine will cause KERMIT-10 to log off the system. ;- BLSRTN(SY%LOGOUT) TOPS20< SETO S1, ; Do it to me LGOUT% ; Do it BLSRET ; Just return >; End of TOPS20 conditional TOPS10< SKIPN LOGDIN## ;[125] Are we logged in? LOGOUT ;[125] No, just logout MOVSI S1,-1 ;[125] We want to detach ourself ATTACH S1, ;[125] Do it JFCL ;[125] If it doesn't work, don't worry MOVEI S1,S2 ; Build arguments in the registers MOVX S2,<SIXBIT /SYS/> ; Run LOGOUT from SYS: MOVX T1,<SIXBIT /LOGOUT/> ; Get the program name SETZB T2,T3 ; No extension and the zero SETZB T4,P1 ; No PPN or core assignment RUN S1,UU.PHY ; Do the UUO HALT . ; Fail. >; End of TOPS10 conditional SUBTTL Operating system interface -- SY%GENERIC ;+ ;.HL1 SY%GENERIC (GCTYPE, STRADR, STRSIZ, GETRTN) ;This routine is called with a generic command. ;It will return either a pointer to a string to be returned to the ;other Kermit (STRADR, STRSIZ), ;or a routine address to call to get characters to be returned (GETRTN), ;or a file name to be transferred (in FILE%NAME, FILE%SIZE). ;- BLSRTN(SY%GENERIC,<GETRTN, STRSIZ, STRADR, GCTYPE>) $SAVE <T1,T2,T3,T4> ; Save T1-4 $SAVE <TF,S2> ; And TF/S2 MOVE S1,GCTYPE ; Get the command type MOVE S2,[XWD -GCTLEN,GCTAB] ; Get the table pointer SYGE.0: MOVE T1,(S2) ; Get the entry CAIE S1,(T1) ; Correct one? AOBJN S2,SYGE.0 ; No, keep looking MOVS T1,T1 ; Point at correct routine JUMPL S2,(T1) ; And call it if we really found one BLSCAL KRM%ERROR##,<[EXP UNIMPLGEN]> ; Give the error BLSRET UNIMPLGEN ; Server command not implemented ; Table of routines for generic commands DEFINE ENT(FUNC,RTN)<XWD SY%'RTN,GC%'FUNC'##> GCTAB: ENT STATUS,STATUS ENT DISK%USAGE,DSK ENT DELETE,DEL ENT DIRECTORY,DIR ENT HELP,HLP ENT TYPE,TYP ENT CONNECT,CWD GCTLEN==.-GCTAB ; Here for a type command. This can only show up from LOCAL, since ;KERMSG normally handles it in server mode SY%TYP: MOVE T1,[POINT 7,FILE%NAME##] ; Point at file name MOVE T2,[POINT 7,GEN%1DATA##] ; And argument MOVE S2,GEN%1SIZE## ; Get length MOVEM S2,FILE%SIZE## ; Store it TYPE.0: ILDB S1,T2 ; Get a byte IDPB S1,T1 ; Store it SOJG S2,TYPE.0 ; Loop for all characters IDPB S2,T1 ; And a null BLSRET NORMAL ; And return the file name ; Here for connect command. Either reset the path to what we had ;when we started, or change to the new one supplied. SY%CWD: SKIPN GEN%1SIZE## ; Any argument? JRST SCWD.3 ; No, just use default MOVX S1,.FDSIZ ; Yes, get length XMOVEI S2,SYSFD ; Point at FD $CALL .ZCHNK ; Clear it out MOVE S1,[POINT 7,GEN%1DATA##] ; Point at the text XMOVEI S2,SYSFD ; And the FD $CALL PRSDIR## ; Parse the directory ; Now copy the path to our PATH block, checking for wild-cards MOVX S1,.PTMAX ; Point at block XMOVEI S2,NEWPTH ; for new path $CALL .ZCHNK ; Clear it out MOVX S2,FD.DIR ; Did we get a directory? TDNN S2,SYSFD+.FDMOD ; . . . JRST SCWD.3 ; No, use default SETO S2, ; Get a convenient minus 1 CAME S2,SYSFD+.FDDIM ; Have a PPN? JRST SCWD.E ; No, illegal wild-card MOVE S1,SYSFD+.FDPPN ; Get the PPN MOVEM S1,NEWPTH+.PTPPN ; Store in path block MOVSI T1,-<.PTMAX-.PTSFD-1> ; Get the number of possible directories SCWD.1: MOVE S1,SYSFD+.FDPAT(T1) ; Get an SFD MOVEM S1,NEWPTH+.PTSFD(T1) ; Store it JUMPE S1,SCWD.2 ; Done? CAME S2,SYSFD+.FDPAT+.FDD2M(T1) ; Any wild-cards? JRST SCWD.E ; Yes, complain AOBJN T1,SCWD.1 ; No, loop SETZM NEWPTH+.PTSFD(T1) ; Ensure we have a zero SCWD.2: SKIPA S1,[EXP NEWPTH] ; Point at new path block SCWD.3: MOVEI S1,DEFPTH ; Point at default path MOVX S2,.PTFSD ; Set default path MOVEM S2,.PTFCN(S1) ; Store function SETZM .PTSWT(S1) ; Clear the flags HRLI S1,.PTMAX ; Full block PATH. S1, ; Set the path JRST SCWD.E ; Error, go give message MOVX S1,.PTFRD ; Get default path back MOVEM S1,NEWPTH+.PTFCN ; Store function MOVE S1,[XWD .PTMAX,NEWPTH] ; Get the current path PATH. S1, ; . . . JFCL ; This better not happen JSP S1,RTNTXT ; Set up to return text $TEXT (<(S1)>,<Default path set to [^O/NEWPTH+.PTPPN,LHMASK/,^O/NEWPTH+.PTPPN,RHMASK/^A>) MOVSI T1,-<.PTMAX-.PTSFD-1> ; Get the number of SFDs possible SCWD.6: SKIPN NEWPTH+.PTSFD(T1) ; Finished? JRST SCWD.7 ; Yes, close off $TEXT (<(S1)>,<,^W/NEWPTH+.PTSFD(T1)/^A>) ; Type the SFD AOBJN T1,SCWD.6 ; Loop for all SFDs SCWD.7: $TEXT (<(S1)>,<]^A>) ; Type the closing bracket $RETT ; And return ; Here on error SCWD.E: KERERR (<Cannot change default path to ^T/GEN%1DATA##/>) BLSRET RMS32 ; Random error ; Routine to handle help command. Just return pointers to the help text. SY%HLP: MOVEI S1,REMHLP ; Get address MOVEM S1,@STRADR ; Save it MOVEI S1,REMHLL ; Get the length MOVEM S1,@STRSIZ ; Save it BLSRET NORMAL ; And return DEFINE TXT (ADDR,LEN,TEXT)< LEN==0 ;; Start out at zero characters IRPC <TEXT>,<LEN==LEN+1> ;; Count the character ADDR: ASCII |'TEXT'| ;; Generate the text > ; End of TXT definition TXT (REMHLP,REMHLL,<Kermit-10 Server handles the following functions: Function Standard command -------- ---------------- Send a file SEND file-spec Retrieve a file GET file-spec Log out from system BYE or LOGOUT Exit from Kermit server FINISH Type a file REMOTE TYPE file-spec List directory REMOTE DIRECTORY file-spec Delete a file REMOTE DELETE file-spec Show disk usage REMOTE DISK Show disk usage for UFD REMOTE DISK device:[PPN] Show status information REMOTE STATUS Type this text REMOTE HELP >) ; End of TXT macro call COMMENT | Change default directory REMOTE CWD new-device/directory Reset default directory REMOTE CWD Copy a file REMOTE COPY old-file-spec New-file-spec Rename a file REMOTE RENAME old-file-spec New-file-spec Send message to user REMOTE SEND terminal-name message text Show who's logged in REMOTE WHO Perform DCL command REMOTE HOST DCL-command | ; Routine to handle generic status command SY%STATUS: MOVEI S1,WRTSTS## ; Get routine which will generate the ; text PJRST RTNTXT ; And go return the text ; Routine to handle disk usage SY%DSK: MOVEI S1,DSKUSE ; Get routine address ; PJRST RTNTXT ; Go do it ; Routine to handle any generic command which just generates text into ;a buffer (less than a page worth). RTNTXT: MOVE T1,S1 ; Save generation routine address SKIPN S1,TXTPAG ; Have a text page? $CALL M%GPAG ; No, get one MOVEM S1,TXTPAG ; Save the address MOVEM S1,@STRADR ; Point at the string for later HRLI S1,(POINT 7,) ; Set up the byte pointer MOVEM S1,TXTPTR ; Save it MOVX S1,<5*PAGSIZ>-1 ; Get the amount of data we can store MOVEM S1,TXTCTR ; Save the counter MOVEI S1,TXTOUT ; Get the output routine $CALL (T1) ; Write the text SETZ S1, ; Write a null to terminate the text IDPB S1,TXTPTR ; Store the null MOVX S1,<5*PAGSIZ>-1 ; Get the max size SKIPLE TXTCTR ; Overfilled? SUB S1,TXTCTR ; No, get amount actually used MOVEM S1,@STRSIZ ; Save the length BLSRET NORMAL ; And return happy ; Handle directory command. SY%DIR: MOVEI S1,.FDSIZ ; Get length of block MOVEI S2,SYSFD ; And address $CALL .ZCHNK ; Clear it out MOVX S1,<<SIXBIT /*/>> ; Get an asterisk MOVEM S1,SYSFD+.FDNAM ; Save name MOVEM S1,SYSFD+.FDEXT ; And extension MOVE S1,[POINT 7,GEN%1DATA##] ; Point at file spec XMOVEI S2,SYSFD ; And at our block $CALL PRSFIL ; Parse the name JUMPF [KERERR (<Illegal file specification ^T/GEN%1DATA##/>) BLSRET RMS32] ; And punt SKIPN SYSFD+.FDNAM ; Did we get some name? JRST [MOVX S1,<<SIXBIT /*/>> ; No, assume all MOVEM S1,SYSFD+.FDNAM ; Store it SETZM S1,SYSFD+.FDNMM ; And the name mask JRST .+1] ; Continue $TEXT (<-1,,GEN%1DATA##>,<^F/SYSFD/^0>) ; rewrite name with defaults SETOM GEN%1SIZE## ; Set up to count size MOVE S2,[POINT 7,GEN%1DATA##] ; . . . DIR.1: ILDB S1,S2 ; Get a character AOS GEN%1SIZE## ; Count it JUMPN S1,DIR.1 ; If more to come, keep trying ; Now process all the files DIR.0: XMOVEI S2,[ITEXT(<^T/DIRHDR/>)] ; Get header ITEXT JSP S1,PROFIL ; Set up for processing each file SKIPE ELB##+.RBTIM ; Have a date/time? $TEXT (TXTOUT,< ^H/ELB##+.RBTIM/^A>) ; Yes, type it $TEXT (TXTOUT,<>) ; And a CRLF BLSCAL (FILE%CLOSE##,<[EXP 0]>) ; Close the file BLSRET NORMAL ; And return ; Header text DIRHDR: ASCIZ / File name Size Creation date words blocks and time / ; Handle delete command. This will delete the file(s) specified in ;the command string. SY%DEL: SKIPN LOGDIN ;[125] Are we logged in? JRST [KERERR (<Cannot delete files when not logged in>) BLSRET RMS32] ;[125] No, can't do this XMOVEI S2,[ITEXT(<^T/FILHDR/>)] ; Just use normal header JSP S1,PROFIL ; Call routine to process file ; ;Here from PROFIL to process one file. S1 is zero if this is the ;first file. Header (up to extension) is already stored. ; File is open on channel FIL. Generate the text for the file being ;deleted, and then delete it. SETZB T1,T2 ; No new name RENAME FIL,T1 ; Delete the file JRST DELE.F ; Failed, give the error $TEXT (TXTOUT,< [OK]>) ; Say we got it DELE.R: BLSCAL (FILE%CLOSE##,<[EXP BLSTRU]>) ; Close the file $RETT ; And return ; Here if a delete fails. Give reasonable error message, but continue DELE.F: $TEXT (TXTOUT,< - ^T/FILERR##(S1)/>) ; Give the error JRST DELE.R ; And return ; Routine to process a set of files. This is used by both the delete and ;directory commands ; Usage: ; XMOVEI S2,Address of ITEXT for first header ; JSP S1,PROFIL ; Enter common routine ; <code to process file> ; ; Text for normal header FILHDR: ASCIZ \ File name Size words blocks \ PROFIL: MOVEM S1,PRORTN ; Save the routine for later MOVEM S2,NXTHDR ; Dump this header before first file SETZM TXTCTR ; Set up as no data to return yet MOVE T1,[POINT 7,GEN%1DATA##] ; Point at argument MOVE T2,GEN%1SIZE## ; And the size MOVEM T2,FILE%SIZE## ; Save the size MOVE S2,[POINT 7,FILE%NAME##] ; Copy to file name PROF.0: ILDB S1,T1 ; Get a character IDPB S1,S2 ; Store it SOJG T2,PROF.0 ; Copy the whole string SETZ S1, ; Make a null IDPB S1,S2 ; Store at end of string ; Now just open the first file (by calling FILE%OPEN), and return the ;address of the routine to get characters. $SAVE <TY%FIL##> ; Save packet type out SETZM TY%FIL## ; Clear packet type out flag BLSCAL FILE%OPEN##,<[EXP 0]> ; Open the file TXNN S1,BLSTRU ; Find it ok? BLSRET RMS32 ; Return ok, error already issued XMOVEI S1,PROF.1 ; Get the routine to fetch characters MOVEM S1,@GETRTN ; Store the so it gets called ; ; Set up place to store text ; SKIPN S1,TXTPAG ; Have a text page? $CALL M%GPAG ; No, get one MOVEM S1,TXTPAG ; Save the address HRLI S1,(POINT 7,) ; Set up the byte pointer MOVEM S1,TXTPTR ; Save it MOVX S1,<5*PAGSIZ>-1 ; Get the amount of data we can store MOVEM S1,TXTCTR ; Save the counter ; ; Now process the first file ; SETZM PRVSTR ; No previous structure SETZM PRVPTH+.PTPPN ; Or path $CALL PROHDR ; Generate the header SETZ S1, ; This is first call $CALL @PRORTN ; Process the first file SETZ S1, ; Write a null to terminate the text IDPB S1,TXTPTR ; Store the null MOVX S1,<5*PAGSIZ>-1 ; Get the max size SKIPLE TXTCTR ; Overfilled? SUB S1,TXTCTR ; No, get amount actually used MOVEM S1,TXTCTR ; Store the count for the fetch MOVE S1,TXTPAG ; Get the address back HRLI S1,(POINT 7,) ; Set up byte pointer MOVEM S1,TXTPTR ; So fetches work BLSRET NORMAL ; Return normal now. The get-a-char ; routine will actually process this file ; Routine called by KERMSG to get a character to return. It will ;process one file and return the text character by character. When ;the text for the file is finished, it will advance to the next file ;by calling NEXT%FILE. If there are no more, it will return EOF. ; BLSRTN (PROF.1,<CHRADR>) ; This is called like GET%FILE SKIPE TXTPAG ; Really have a page? JRST PROF.3 ; Yes, no problem BLSRET EOF ; Return end of file if no page PROF.3: SOSGE TXTCTR ; Any characters left? JRST PROF.2 ; No, process file ILDB S1,TXTPTR ; Get a character MOVEM S1,@CHRADR ; Store it BLSRET NORMAL ; And return ; Here when we run out of data to return. Process the next file. PROF.2: $SAVE <TY%FIL##> ; Save file type out flag SETZM TY%FIL## ; And clear it $CALL NEXT%FILE## ; Get next file TXNE S1,BLSTRU ; Good return? CAIN S1,NOMORFILES ; None left? JRST [SETZ S1, ; Clear S1 EXCH S1,TXTPAG ; Get current page address $CALL M%RPAG ; Return it BLSRET EOF] ; All done, return EOF ; Here when we get a new file. Call the processing routine. MOVX S1,<5*PAGSIZ>-1 ; Reset counter MOVEM S1,TXTCTR ; . . . MOVE S1,TXTPAG ; Get address of page HRLI S1,(POINT 7,) ; Make it a byte pointer MOVEM S1,TXTPTR ; Save it $CALL PROHDR ; Generate the header SETO S1, ; Not first call $CALL @PRORTN ; Do it SETZ S1, ; Write a null to terminate the text IDPB S1,TXTPTR ; Store the null MOVX S1,<5*PAGSIZ>-1 ; Get the max size SKIPLE TXTCTR ; Overfilled? SUB S1,TXTCTR ; No, get amount actually used MOVEM S1,TXTCTR ; Store new count MOVE S1,TXTPAG ; Reset byte pointer HRLI S1,(POINT 7,) ; . . . MOVEM S1,TXTPTR ; . . . PJRST PROF.3 ; And return the character ; Routine to generate the start of the line for processing a file ; It will generate a new device/path line only if it changes PROHDR: SKIPN NXTHDR ; Have a header to dump first? JRST PROH.0 ; No, continue $TEXT (TXTOUT,<^I/@NXTHDR/^A>) ; Yes, do it SETZM NXTHDR ; Done now PROH.0: SETZ T1, ; Assume we don't need path SKIPN S1,FPTH## ; Get structure file was on MOVE S1,ELB+.RBDEV ; Try hard to find it JUMPN S1,.+2 ; Get something? MOVE S1,FLP##+.FODEV ; No, use device name from FILOP CAMN S1,PRVSTR ; Same structure as before? JRST PROH.1 ; Yes, check path MOVEM S1,PRVSTR ; No, save new structure $TEXT (TXTOUT,<^M^J^W/PRVSTR/:^A>) ; List the structure name MOVEI T1,1 ; Need to list path PROH.1: MOVSI S2,-<.PTMAX-.PTPPN-1> ; Get number of words to check PROH.2: MOVE S1,FPTH+.PTPPN(S2) ; Get current item CAME S1,PRVPTH+.PTPPN(S2) ; Same? TRO T1,2 ; Need to list path MOVEM S1,PRVPTH+.PTPPN(S2) ; Save the PPN AOBJN S2,PROH.2 ; Loop for all entries JUMPE T1,PROH.5 ; If nothing changed, continue on TRNN T1,1 ; Need a leading CRLF? $TEXT (TXTOUT,<>) ; Yes, do it $TEXT (TXTOUT,<[^O/PRVPTH+.PTPPN,LHMASK/,^O/FPTH+.PTPPN,RHMASK/^A>) MOVSI S1,-<.PTMAX-.PTSFD-1> ; Now some SFD's PROH.3: SKIPN PRVPTH+.PTSFD(S1) ; Have a SFD? JRST PROH.4 ; No, all done $TEXT (TXTOUT,<,^W/PRVPTH+.PTSFD(S1)/^A>) ; Yes, list it AOBJN S1,PROH.3 ; Loop for all of them PROH.4: $TEXT (TXTOUT,<]>) ; End of path ; Now list the file name and extension PROH.5: $TEXT (TXTOUT,<^W6L /ELB+.RBNAM/.^W3L /ELB+.RBEXT,LHMASK/^A>) $TEXT (TXTOUT,< ^D8R /ELB##+.RBSIZ/ ^D6R /ELB##+.RBALC/^A>) ; List the file size $RETT ; And return SUBTTL Operating system interface -- SY%DISMISS ;+ ;.HL1 SY%DISMISS(seconds) ;This routine will cause KERMIT to sleep the specified number of seconds. ;- BLSRTN(SY%DISMISS,<SECONDS>) TOPS10< SKIPLE S1,SECONDS ; Get the number of seconds SLEEP S1, ; Go away for that many JFCL ; No error return BLSRET NORMAL ; Give a good return >; End of TOPS10 conditional SUBTTL Support routines -- DSKUSE ; This routine will generate the text for the disk usage generic ;command. ; ; Usage: ; S1/ output-a-character routine address ; GEN%1D - Argument <disk:><[ppn]> ; $CALL DSKUSE ; return here always ; DSKUSE: $SAVE <P1,P2,P3> ; Save a register MOVEI P2,[ITEXT(<>)] ; String to output before MOVE P1,S1 ; Save the pointer MOVX P3,.PTFRD ; Read current default path MOVEM P3,NEWPTH+.PTFCN ; . . . MOVE P3,[XWD .PTMAX,NEWPTH] ; . . . PATH. P3, ; From monitor SKIPA P3,MYPPN## ; Can't get it, use PPN instead MOVE P3,NEWPTH+.PTPPN ; Get PPN of current path SETOM JOBBLK+.DFJNM ; Initialize the structure name ; ; Once the defaults are set, now try to do a specific if given ; SKIPN GEN%1SIZE## ; Have any characters? JRST DSKU.0 ; No, skip this MOVX S1,.FDSIZ ; Get the size of the block XMOVEI S2,SYSFD ; And the address $CALL .ZCHNK ; Clear it out MOVEI S1,GEN%1DATA## ; Point to the data HRLI S1,(POINT 7) ; Build a byte pointer to it XMOVEI S2,SYSFD ; Point to the FD $CALL PRSFIL## ; Parse the file JUMPF DSKU.0 ; Failed, do them all SKIPE SYSFD+.FDPPN ; Have a PPN? MOVE P3,SYSFD+.FDPPN ; Yes, get the PPN MOVE S1,SYSFD+.FDSTR ; Get the structure CAXN S1,<SIXBIT /DSK/> ; Is this DSK:? JRST DSKU.0 ; Do the looping MOVEM S1,JOBBLK+.DFJNM ; No, store for later $TEXT (<(P1)>,<^I/DSKHDR/>) ; Do the header PJRST DSKSUB ; Do the structure ; ; Here to loop over all of the file structures ; DSKU.0: $TEXT (<(P1)>,<^I/DSKHDR/>) ; Do the header DSKU.1: MOVE S1,[XWD .DFJBL,JOBBLK] ; Get the argument block address JOBSTR S1, ; Get the structure information $RETT ; Just return at this point MOVE S1,JOBBLK+.DFJNM ; Get the structure name CAXN S1,-1 ; Is this the end? $RETT ; Yes, just reutrn JUMPE S1,DSKU.2 ; Jump if we have a fence $CALL DSKSUB ; Handle the single structure JRST DSKU.1 ; Loop for the next DSKU.2: MOVEI P2,[ITEXT( -- Fence --^M^J)] ; Get the ITEXT to output JRST DSKU.1 ; Loop for the next one ;+ ;.hl2 DSKSUB ;Routine to output the disk usage for a specific structure. ;.literal ; ; Usage: ; P1/ Output routine to use ; P2/ ITEXT to output before structure name ; P3/ PPN to use ; ;.end literal ;- DSKSUB: MOVX S1,.RBMAX ; Get the length XMOVEI S2,UFDELB ; Point to the block $CALL .ZCHNK ; Clear the block MOVX S1,.RBMAX ; Get the length MOVEM S1,UFDELB+.RBCNT ; Store as the count MOVE S1,P3 ; Get the PPN MOVEM S1,UFDELB+.RBNAM ; Store the name MOVX S1,<SIXBIT /UFD/> ; Get the quotas from the UFD MOVEM S1,UFDELB+.RBEXT ; Store this MOVE S1,MFDPPN## ; Get the UFDPPN MOVEM S1,UFDELB+.RBPPN ; Store the PPN MOVX T1,UU.PHS!.IODMP ; Get the mode MOVE T2,JOBBLK+.DFJNM ; Get the structure SETZM T3 ; Clear the buffer pointers OPEN 0,T1 ; Open the structure $RETF ; Failed, return failure LOOKUP 0,UFDELB ; Look for the quotas JRST DSKS.1 ; Failed, clean up MOVE T1,JOBBLK+.DFJNM ; Get the name MOVE T2,P3 ; Get my PPN MOVX S1,<XWD .DUFRE,T1> ; Point to the arguments DISK. S1, ; Get the quota JRST [MOVE S1,UFDELB+.RBQTF ; Get amount used SUB S1,UFDELB+.RBUSD ; Get amount free JRST .+1] ; Continue PUSH P,S1 ; Save the amount FCFS free MOVE T1+.DCNAM,JOBBLK+.DFJNM ; Get the structure name MOVX S1,<XWD .DCFCT+1,T1> ; Point to the arguments DSKCHR S1, ; Get the information JRST [POP P,(P) ; Remove this JRST DSKS.1] ; Keep going POP P,S1 ; Restore S1 MOVE S2,T1+.DCFCT ; Get the amount free on the structure MOVE T1,UFDELB+.RBQTF ; Get the FCFS quota SUB T1,S1 ; Determine the amount used MOVE T2,UFDELB+.RBQTO ; Get the logged out quota SUB T2,T1 ; Determine the amount of logged out quota left $TEXT (<(P1)>,<^I/(P2)/^W9/JOBBLK+.DFJNM/^D8R /T1/ ^D13R /S1/ ^D12R /T2/ ^D13R /S2/>) TRNA ; Skip $TEXT and return to caller DSKS.1: $TEXT (<(P1)>,<^I/(P2)/^W9/JOBBLK+.DFJNM/ - No directory on this structure ->) MOVEI P2,[ITEXT()] ; Nothing to output RELEAS 0, ; Release the channel $RETT ; Give a good return DSKHDR: ITEXT(<User: ^P/P3/^M^J^T/DSKHD1/^M^J^T/DSKHD2/^M^J>) DSKHD1: ASCIZ |Structure Blocks Logged in Logged out System storage| DSKHD2: ASCIZ | Used quota left quota left left| SUBTTL Support routines -- Text writing ; This routine is used as the output routine for $TEXT calls. It ;will write the characters into the page we have set up. TXTOUT: SOSL TXTCTR ; Count the character IDPB S1,TXTPTR ; Store the character if we have room $RETT ; And return SUBTTL Data storage RELOC ; This is low segment LOWBEG:! ; ; Anything that parses file specifications uses this ; SYSFD: BLOCK .FDSIZ ; File specification block ; ; For text writing routines ; TXTPAG: BLOCK 1 ; Text page address TXTPTR: BLOCK 1 ; Byte pointer into page TXTCTR: BLOCK 1 ; Byte counter for page ; ; For file processing routines ; PRORTN: BLOCK 1 ; Routine to process a file PRVSTR: BLOCK 1 ; Last structure seen PRVPTH: BLOCK .PTMAX ; Last path seen NXTHDR: BLOCK 1 ; ITEXT to put out as header before next file ; ; For CWD ; DEFPTH: BLOCK .PTMAX ; Default path on startup NEWPTH: BLOCK .PTMAX ; New path desired ; ; For DSKUSE ; UFDELB: BLOCK .RBMAX JOBBLK: BLOCK .DFJBL LOWSIZ==.-LOWBEG ; Size of data SUBTTL End of KERSYS END